00100		SUBROUTINE PLTMAN
00200
00300		COMMON/PLT/JX,JY,JPL,PLT,REV,RINV,IPOG,RLR,RUD,CONST
00350		1 ,JREV,JINV,KA,KB,KC,KD,RTO,JA,JB,JAR,JBR
00400	
00600		EQUIVALENCE(LIST,CURV)
00700
00800		DIMENSION CURV(2,3000),HIST(0/63),DIF(3)
01000
01100		COMMON /EDGEC/ A0,A1,A2,A3,A4,A5,A6,A7,
01200		1 DEBUG,TE(1),XP(1),YP(1),PARMAX,
01300		1 HALF,FILE,RR,COH,RX,RY,CL,SL,D,B,FOUND
01400
01500		COMMON /LISTC/LIST(6,1000),LIST5(0/1000),NEWEND,LO
01600
01700		COMMON/COMMAC/BCLIP,TCLIP,BITS,IWID,LINLEN,FLINE,LLINE,
01800		1 LSIDE,RSIDE,DTA,HYSTAB(1)
01900
02000		INTEGER FI,FILEN,EWE,HIST,BITS,
02100		1 XIX,XI,FLINE,RSIDE,
02200		1 NUM2,NUM3,ID,PL,LIST5,X
02300
02400		REAL LIST,RR,CL,SL,LEAP,LEA6,LEA3,CONST,FRAC,
02500		1 RX,RY,TEXT,TH,W1,W2,B1,B2,V1,V2,
02600		1 LV,LW,LB,D1,D2,CURV,T,X1,X2,A1,A2,C1,C2,MA,LC,
02700		1 D,B,DIF,B0,BB1,C3,C4
02800		DATA JJX/2/
02900		DIF(1)=0.0
03000		B0=0.0
03100		BB1=2**BITS-1
03200		IXYZ=0
03300		CONST=2.41
03400		IF(FLINE.EQ.0.AND.LSIDE.EQ.0.AND.
03500		1 LLINE.EQ.252.AND.RSIDE.EQ.251) CONST=CONST*.6667
04000	68	LEAP=(RR/2.+CONST)*RTO
04100		LEA6=LEAP/6.
04200		LEA3=LEAP/3.
04300		TH=(LEAP**2)*0.075
04400
04500		DO 70 ID=0,63
04600	70	HIST(ID)=0
14800		FRAC=64.0/FLOAT(2**BITS)
14900		DO 100 XIX=1,NEWEND
15000		ID=IFIX(LIST(5,XIX)*FRAC+0.5)
15100		IF(0.GT.ID) ID=0
15200		IF(63.LT.ID) ID=63
15300		HIST(ID)=HIST(ID)+1
15400	100	CONTINUE
15500
15600		DO 110 ID=1,63
15700	110	HIST(ID)=HIST(ID)+HIST(ID-1)
15800		IF(HIST(63).NE.NEWEND) PAUSE 'ERROR IN PLOU'
15900		NUM2=IFIX(FLOAT(NEWEND)/3.+0.5)
16000		NUM3=IFIX(FLOAT(NEWEND)*2./3.+0.5)
16100		DO  121 ID=1,63
16200		IF(NUM2.GE.(HIST(ID)+HIST(ID-1))/2) DIF(2)=FLOAT(
16300		1 ID)/FRAC
16400	121	IF(NUM3.GE.(HIST(ID)+HIST(ID-1))/2) DIF(3)=FLOAT(
16500		1 ID)/FRAC
16600
16700		DO 123 I=0,1000
16800	123	LIST5(I)=1
16900
17000	125	XI=1
17100		DO 120 XIX=1,NEWEND
17200		D=LIST(5,XIX)
17300		B=LIST(6,XIX)
17400		IF(((B+D.LT.B0+DIF(1)).OR.(B.GT.BB1-DIF(1)
17500		1 )).OR.(D.LT.DIF(1))) GOTO 120
17600		RX=LIST(1,XIX)*RTO
17700		RY=LIST(2,XIX)*RTO
17800		CL=LIST(3,XIX)*LEA6
17900		SL=LIST(4,XIX)*LEA6
18000		CURV(1,XI)=RX-SL
18100		CURV(2,XI)=RY+CL
18200		CURV(3,XI)=RX+SL
18300		CURV(4,XI)=RY-CL
18400		IF(((B+D.LT.B0+DIF(2)).OR.(B.GT.BB1-DIF(2)
18500		1 )).OR.(D.LT.DIF(2))) GOTO 118
18600		LIST5((XI-1)/2)=2
18700		IF(((B+D.LT.B0+DIF(3)).OR.(B.GT.BB1-DIF(3)
18800		1 )).OR.(D.LT.DIF(3))) GOTO 118
18900		LIST5((XI-1)/2)=3
19000	118	XI=XI+2
19100	120	CONTINUE
19200
19300		DO 400 PL=1,3
19400
19500		GOTO(140,130,130),PL
19600	130	X=1
19700		DO 136 XI=1,EWE-3,2
19800		I=(XI-1)/2
19900		IF(LIST5(I).LT.PL) GOTO 136
20000		C1=CURV(1,XI)
20100		C2=CURV(2,XI)
20200		C3=CURV(3,XI)
20300		C4=CURV(4,XI)
20400		CURV(1,X)=C1
20500		CURV(2,X)=C2
20600		CURV(3,X)=C3
20700		CURV(4,X)=C4
20800		LIST5((X-1)/2)=LIST5(I)
20900		X=X+2
21000	136	CONTINUE
21100		XI=X
21200
21300	140	EWE=XI+1
21400		FI=1
21500		LA=0
21600		DO 135 XIX=4,EWE,2
21700		LI=XIX-2
21800
21900		IF((2.*CURV(1,LI)-CURV(1,XIX-3)-2.*CURV(1,XIX-1)+
22000		1 CURV(1,XIX))**2+(2.*CURV(2,LI)-CURV(2,XIX-3)-
22100		1 2.*CURV(2,XIX-1)+CURV(2,XIX))**2.LT.TH) GOTO 135
22200
22300		LA=LI
22400		KI=FI+1
22500		IF(KI.EQ.LA) GOTO 200
22600		IF(PL.GT.1) GOTO 200
22700
22800		CURV(1,FI)=CURV(1,FI)*1.5-CURV(1,KI)*0.5
22900		CURV(2,FI)=CURV(2,FI)*1.5-CURV(2,KI)*0.5
23000		CURV(1,LA)=CURV(1,LA)*1.5-CURV(1,LA-1)*0.5
23100		CURV(2,LA)=CURV(2,LA)*1.5-CURV(2,LA-1)*0.5
23200
23300	200	JA=RLR*CURV(1,FI)+.5
23400		JB=RUD*CURV(2,FI)+.5
23500	CC	IF(IABS(JA-JAR).LT.4.AND.IABS(JB-JBR).LT.4)JCNT=JCNT+1
23700		JA=JA/JPL+JX
23800		JB=JB/JPL+JY
23900		IF(REV.NE.0)JA=JREV-JA
24100	2004	IF(RINV.NE.0)JB=JINV-JB
24210		IF(PLT)GO TO 2001
24300	2003	CALL RIVECT(JA-JAR,JB-JBR)
24400		JAR=JA
24500		JBR=JB
24600		GO TO 2002
24700	2001	CALL PLOT(JA,JB,3)
24800	2002	NI=LA-2
24900		JI=FI-1
25000		DO 210 I=JI,NI
25100		KI=I+1
25200		LI=KI+1
25300		MI=LI+1
25400		B1=CURV(1,LI)-CURV(1,KI)
25500		B2=CURV(2,LI)-CURV(2,KI)
25600		IF (I.EQ.JI) GOTO 202
25700		A1=CURV(1,KI)-CURV(1,I)
25800		A2=CURV(2,KI)-CURV(2,I)
25900		GOTO 204
26000	202	A1=B1
26100		A2=B2
26200	204	IF (I.EQ.NI) GOTO 206
26300		C1=CURV(1,MI)-CURV(1,LI)
26400		C2=CURV(2,MI)-CURV(2,LI)
26500		GOTO 208
26600	206	C1=B1
26700		C2=B2
26800	208	MA=A1**2+A2**2
26900		LB=B1**2+B2**2
27000		LC=C1**2+C2**2
27100		V1=A1*LB+B1*MA
27200		V2=A2*LB+B2*MA
27300		W1=B1*LC+C1*LB
27400		W2=B2*LC+C2*LB
27500		LV=SQRT(V1**2+V2**2)
27600		LW=SQRT(W1**2+W2**2)
27700		LB=SQRT(LB)
27800	CC	IF (LV.LT.1.E-6.OR.LW.LT.1.E-6) PAUSE 'LV LW'
27900		AA=LB*.5858
28000		AB=AA/LW
28100		AA=AA/LV
28200		V1=V1*AA
28300		V2=V2*AA
28400		W1=W1*AB
28500		W2=W2*AB
28600		D1=B1-V1-W1
28700		D2=B2-V2-W2
28800
28900		DO 220 K=1,8
29000		T=FLOAT(K)/8.
29100		T1=2.-T
29200		T2=3.-2.*T
29300		IX1=RLR*(CURV(1,KI)+(V1*T1+(W1+D1*T2)*T)*T+.5)
29400		IX2=RUD*(CURV(2,KI)+(V2*T1+(W2+D2*T2)*T)*T+.5)
29500		NA=2
29910		JA=IX1/JPL+JX
29920		JB=IX2/JPL+JY
29922		IF(A)GO TO 221
29924		IF(JA.GE.KA.AND.JA.LE.KB.AND.JB.GE.KC.AND.JB.
29926		1 LE.KD)NA=3
29928	C   LEAVES CLEAR AREA
29930	221	IF(REV.NE.0)JA=JREV-JA
29940		IF(RINV.NE.0)JB=JINV-JB
30000		IF(PLT.EQ.0)GO TO 220
30100		CALL PLOT(JA,JB,NA)
30200	220	CONTINUE
30300	2222	IF(PLT)GO TO 210
30400		IF(IXYZ)GO TO 211
30700		NC=JA-JAR
30800		ND=JB-JBR
30900		IF(NA.EQ.3)GO TO 222
31000		CALL RVECT(NC,ND)
31100		GO TO 223
31200	222	CALL RIVECT(NC,ND)
31300	223	JAR=JA
31400		JBR=JB
31500	211	IXYZ=IXYZ-1
31600		IF(IXYZ.EQ.-3)IXYZ=0
31700	C  DPY EVERY 5TH TIME.
31800	210	CONTINUE
31900
32000		IF(PLT.EQ.0)CALL DPYOUT(IPOG)
32100	135	FI=LA+1
32200		GOTO(300,300,500),PL
32300	300	TYPE 301
32400		ACCEPT 1001,WHICH
32500		IF(WHICH.EQ.'E'.OR.WHICH.EQ.'X')GO TO 500
32600		IF(WHICH.EQ.'R')GO TO 500
32700	C  R=GO BACK FOR CHANGE BEFORE FINAL END.
32800	301	FORMAT(' CHANGE THE PEN OR EXIT?'/)
32900		IF(PLT.EQ.0)GO TO 400
33000		JX=JX+JJX
33100		JY=JY+JJX
33200	C  MOVES PEN JJX NOTCHES EACH TIME AROUND.
33300	400	CONTINUE
33400	500	IF(PLT)CALL PLOT(0,0,3)
33500		RETURN
33650	1001 	FORMAT(A1)
33700		END